home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pvga.zip
/
PVGA.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
33KB
|
743 lines
Program Paradise_VGA; (* Written: 01/09/1989 10:35:39 *)
{
[][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
[] Program Paradise_VGA []
[] []
[] The intent of this program is to provide thoroughly tested text []
[] and graphics display routines for Paradise VGA boards: []
[] []
[] - Paradise VGA Plus []
[] - Paradise VGA Plus 16 []
[] - Paradise VGA Professional []
[] []
[] While standard CGA, EGA, MCGA, and VGA video routines are well []
[] documented, video board manufacturers have extended both text and []
[] graphics beyond the IBM standard. The problem is that routines to []
[] identify a Super-VGA board and access the extended modes are []
[] different for each manufacturer. []
[] []
[] ------------------------------------------------------------------ []
[] It's hoped that this program will serve as authoritative []
[] information for programmers wishing to write for the Paradise []
[] VGAs, and also as a starting point for an exchange of information []
[] about different VGA boards. []
[] []
[] Hopefully, similar programs for other VGA boards will appear, []
[] gradually building a Super-VGA "programmer's data base", and we []
[] can all benefit from sharing this type of information. []
[] []
[] If you program (text or) graphics routines for a Super-VGA, please []
[] consider sharing the information with the rest of us! []
[] ------------------------------------------------------------------ []
[] []
[] I've included code for standard text and graphics modes so that []
[] the program demonstrates a wide range of text and graphics []
[] displays. However, of primary interest are the Paradise detect []
[] routine and the Paradise extended ("Super-VGA") modes: []
[] []
[] Text: 132x25 Graphics: 800x600x16 []
[] 80x50 640x400x256 []
[] 132x43 640x480x256 []
[] []
[] All routines are written in Turbo Pascal (v/4 or 5), and also in []
[] Turbo Assembler (MASM programmers will have no problem reading []
[] TASM.) The compiler directive "UseAssemblerRoutines" determines []
[] whether PVGA.ASM/PVGA.OBJ or the Pascal code will be used. []
[] []
[] For Turbo Pascal programmers: []
[] ---------------------------- []
[] The Turbo Pascal CRT unit is used to set text and background []
[] color, position the cursor, and "fast write" text in text modes. []
[] Note that the CRT.Window procedure does range checking, and []
[] rejects attempts to set the window for the 132 column text modes. []
[] However, setting CRT.WindMax circumvents the problem, so that the []
[] cursor is positioned correctly via CRT.GotoXY. []
[] []
[] Bob Berry [76555,167] []
[] []
[] 01/16/1989 - Version 2.0 []
[] ------------------------ []
[] 512k Detect: We can compare video RAM banks 0 and 1 while the []
[] program is in text mode (at startup), to verify bank switching, []
[] and identify a Paradise VGA. HOWEVER, the compare of banks 0 and []
[] 64, to identify 512k FAILS in text mode. Apparently the attempt []
[] to switch to bank 64 is rejected if the card is in text mode. []
[] So, it's necessary to set a graphics mode before performing the []
[] comparison of banks 0 and 64, or all cards will be identified as []
[] having only 256k. []
[] []
[][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
}
{$Define UseAssemblerRoutines }
{ change "$Define" to "$UnDef" to use Pascal code }
Uses DOS, CRT;
Const Video = $10; { Video Interrupt }
ESCape = ^[;
Null = #0;
LeftArrowHead = #17;
RightArrowHead = #16;
UpArrowHead = #30;
DownArrowHead = #31;
HorizontalLine = #196;
VerticalLine = #179;
Options = 16; { 0..16 }
InfoLines = 17;
InfoLine: array[1..InfoLines] of String[36] = (
'╔══════════════════════════════════╗',
'║ Display modes identified as ║',
'║ "SVGA" are "Super-VGA" modes, ║',
'║ which will display on a Paradise ║',
'║ VGA adapter: ║',
'║ ║',
'║ - Paradise VGA Plus ║',
'║ - Paradise VGA Plus 16 ║',
'║ - Paradise VGA Professional ║',
'║ ║',
'║ NOTE: ║',
'║ 800x600x16 requires multi-sync ║',
'║ monitor ║',
'║ 640x480x256 requires 512k ║',
'║ VGA Professional ║',
'║ ║',
'╚══════════════════════════════════╝');
GoodbyLines = 17;
GoodbyLine: array[1..GoodbyLines] of String[76] = (
'PVGA: Version 2',
'This program (PVGA.EXE) and the source (PVGA.PAS and PVGA.ASM) are released',
'to the Public Domain, in hopes that it will encourage the exchange of',
'information about "Super-VGA" programming techniques.',
'',
'The program source will be posted to the CompuServe Graphics Support forum',
'(GO PICS) in the Video Adapters library (DL7) as PVGA.ARC. It is intended to',
'provide programmers with valid, tested routines for utilizing the extended',
'Paradise VGA text and graphics modes, as well as a number of the standard',
'text and graphics modes.',
'',
'Anyone with Super-VGA programming routines for other boards is encouraged to',
'upload them to PICS DL7. Of particular interest (to me, anyway) is a',
'"detect" routine for each Super-VGA, and the method used to set Super-VGA',
'modes and address video RAM, particularly in 256 color modes.',
'',
'Bob Berry [76555,167]');
(*
+----------------------------------------------------------------------+
| NOTE for non-pascal programmers: |
| Turbo Pascal's "enumerated types" are used as a convenient shorthand |
| method for establishing a "series of constants". For example: |
| |
| Type VideoTypeType = (UnSupported,MDA, CGA, EGA, MCGA, VGA, PVGA); |
| |
| is equivalent to: |
| |
| Const UnSupported = 0; (or in assembler) UnSupported equ 0 |
| MDA = 1; MDA equ 1 |
| CGA = 2; CGA equ 2 |
| etc. |
+----------------------------------------------------------------------+
*)
Type VideoTypeType = (UnSupported,
MDA, CGA, EGA, MCGA, VGA, PVGA);
ModeType = (T_80x25x2, { MDA }
T_80x25x16, { CGA }
T_80x43x16, { EGA }
T_80x50x16, { VGA }
T_132x25x16, { PVGA }
T_132x43x16, { PVGA }
G_640x200x2, { CGA }
G_320x200x4, { CGA }
G_320x200x16, { EGA }
G_640x200x16, { EGA }
G_640x350x16, { EGA }
G_640x480x2, { MCGA }
G_320x200x256, { MCGA }
G_640x480x16, { VGA }
{ MultiSync required } G_800x600x16, { PVGA }
G_640x400x256, { PVGA }
{ 512k required } G_640x480x256); { PVGA }
ModeSpecType = record
MaxX, MaxY,
MaxC, Mode: Word;
Method, Desc: VideoTypeType;
end;
{ ModeSpec identifies the maximum X, Y, and colors, the BIOS mode number,
method for writing (graphics) and the description of each mode. }
Const ModeSpec: Array[ModeType] of ModeSpecType = (
(MaxX: 80; MaxY: 25; MaxC: 2; Mode: 7; Method: MDA; Desc: MDA),
(MaxX: 80; MaxY: 25; MaxC: 16; Mode: 3; Method: CGA; Desc: CGA),
(MaxX: 80; MaxY: 43; MaxC: 16; Mode: 3; Method: EGA; Desc: EGA),
(MaxX: 80; MaxY: 50; MaxC: 16; Mode: 3; Method: VGA; Desc: VGA),
(MaxX: 132; MaxY: 25; MaxC: 16; Mode: 85; Method: PVGA; Desc: PVGA),
(MaxX: 132; MaxY: 43; MaxC: 16; Mode: 84; Method: PVGA; Desc: PVGA),
(MaxX: 640; MaxY: 200; MaxC: 2; Mode: 6; Method: CGA; Desc: CGA),
(MaxX: 320; MaxY: 200; MaxC: 4; Mode: 4; Method: CGA; Desc: CGA),
(MaxX: 320; MaxY: 200; MaxC: 16; Mode: 13; Method: EGA; Desc: EGA),
(MaxX: 640; MaxY: 200; MaxC: 16; Mode: 14; Method: EGA; Desc: EGA),
(MaxX: 640; MaxY: 350; MaxC: 16; Mode: 16; Method: EGA; Desc: EGA),
(MaxX: 640; MaxY: 480; MaxC: 2; Mode: 17; Method: EGA; Desc: MCGA),
(MaxX: 320; MaxY: 200; MaxC: 256; Mode: 19; Method: MCGA; Desc: MCGA),
(MaxX: 640; MaxY: 480; MaxC: 16; Mode: 18; Method: EGA; Desc: VGA),
(MaxX: 800; MaxY: 600; MaxC: 16; Mode: 88; Method: EGA; Desc: PVGA),
(MaxX: 640; MaxY: 400; MaxC: 256; Mode: 94; Method: PVGA; Desc: PVGA),
(MaxX: 640; MaxY: 480; MaxC: 256; Mode: 95; Method: PVGA; Desc: PVGA) );
{ ModeAvailable defines which modes are available on each type of adapter }
ModeAvailable: Array[MDA..PVGA,T_80x25x2..G_640x480x256] of Boolean = (
{MDA} (True, False,False,False,False,False,
False,False,False,False,False,False,False,False,False,False,False),
{CGA} (False,True, False,False,False,False,
True, True, False,False,False,False,False,False,False,False,False),
{EGA} (False,True, True, False,False,False,
True, True, True, True, True, False,False,False,False,False,False),
{MCGA} (False,True, False,False,False,False,
True, True, False,False,False,True, True, False,False,False,False),
{VGA} (False,True, False,True, False,False,
True, True, True, True, True, True, True, True, False,False,False),
{PVGA} (False,True, False,True, True, True,
True, True, True, True, True, True, True, True, True, True, True ));
Type Palette256Type = Array[0..255,0..2] of Byte;
{ Define types and variables to address CGA, MCGA, and EGA video RAM }
CGAPageType = Array[0..99,0..79] of Byte;
MCGAScreenType = Array[0..199,0..319] of Byte;
EGAScreenType = Array[0..59999] of Byte;
Var CGA0: {even numbered lines} CGAPageType absolute $B800:$0000;
CGA1: { odd numbered lines} CGAPageType absolute $BA00:$0000;
MCGA0: MCGAScreenType absolute $A000:$0000;
EGA0: EGAScreenType absolute $A000:$0000;
VideoType: VideoTypeType;
VMode: ModeType;
ParadiseRam: Word;
P_VGA: Boolean;
Regs: Registers;
Ch: Char;
TextModeNumber, SelectionLine: Byte;
NeedNewScreen, Bypassed: Boolean;
Palette256: Palette256Type;
Pixels: Array[0..799] of Byte;
N: Word;
(* .........................................................................
Video_ID.Obj procedure IdentifyVideo will identify the type of video
adapter attached to the system.
It's based on routines from Programmer's Guide to PC & PS/2 Video Systems
by Richard Wilton (ISBN 1-55615-103-9) from MicroSoft Press. Although
modified, the original source is copyrighted, and as such is not included.
.......................................................................... *)
Procedure IdentifyVideo; External; {$L Video_ID }
Procedure Wait;
Var C: Char;
begin
C:=ReadKey; If C=Null then C:=ReadKey;
end; { Procedure Wait }
Function InterpretModeDescription(D: VideoTypeType): String;
begin
Case D of
MDA: InterpretModeDescription:=' MDA';
CGA: InterpretModeDescription:=' CGA';
EGA: InterpretModeDescription:=' EGA';
VGA: InterpretModeDescription:=' VGA';
MCGA: InterpretModeDescription:='MCGA';
PVGA: InterpretModeDescription:='SVGA';
end; { Case D }
end; { Function InterpretModeDescription }
{$IfDef UseAssemblerRoutines }
{ _____________________________ Assembler Routines _________________________ }
Procedure Paradise_Detect; External;
Procedure Paradise_Unlock; External;
Function Paradise_Address(Row, Col: Word): Word; External;
Procedure SetVideoMode_(Mode: byte; TextLines: Word); External;
Procedure ClearTextScreenAndSetBorder(X, Y, A, B: Byte); External;
Procedure SetMCGAPalette; External;
Procedure SetEgaWriteMode(Mode: Byte); External; {$L PVGA }
Procedure SetVideoMode(ModeNumber, TextLines: Word);
begin
SetVideoMode_(Lo(ModeNumber),TextLines);
If P_VGA then Delay(750) else Delay(200);
end; { Procedure SetVideoMode }
{$Else }
{ _____________________________ Pascal Routines ____________________________ }
Procedure SetVideoMode(ModeNumber, TextLines: Word);
Var InfoByte: Byte absolute $40:$87; { DOS data area at segment 0040h }
{ Video "Info Byte" at 0040h:0087h }
begin
With Regs do
begin
InfoByte:= InfoByte and $FE;
Ax:=ModeNumber; Intr(Video,Regs);
Case TextLines of
43: If VideoType=EGA then
begin
Ax:=$1112; Bl:=0; Intr(Video,Regs);
InfoByte:=InfoByte or $01;
Ax:=$0100; Cx:=$0600; Intr(Video,Regs);
Ah:=$12; Bl:=$20; Intr(Video,Regs);
end;
50: begin
Ax:=$1112; Bl:=0; Intr(Video,Regs);
end;
end; { Case TextLines }
end;
If P_VGA then Delay(750) else Delay(200);
end; { Procedure SetVideoMode }
Procedure Paradise_Unlock;
begin
With Regs do
begin
Al:=$0F; Ah:=$05; PortW[$3CE]:=Ax; { "unlock write access" }
end;
end; { Procedure Paradise_Unlock }
Procedure SelectBank(Bank: Byte);
begin
With Regs do begin Ah:=Bank; Al:=9; PortW[$3CE]:=Ax; end;
end; { Procedure SelectBank }
Function BankDifferent(Bank1, Bank2: Byte; Segment: Word): Boolean;
Var VideoByte: ^Byte;
Was1, Was2,
Set1, Set2,
Is1, Is2: Byte;
begin
VideoByte:=Ptr(Segment,0);
Set1:=$11; Set2:=$22;
SelectBank(Bank1); Was1:=VideoByte^; VideoByte^:=Set1;
SelectBank(Bank2); Was2:=VideoByte^; VideoByte^:=Set2;
SelectBank(Bank1); Is1:=VideoByte^; VideoByte^:=Was1;
SelectBank(Bank2); Is2:=VideoByte^; VideoByte^:=Was2;
SelectBank(0);
BankDifferent:=(Is1=Set1) and (Is2=Set2);
end; { Function BankDifferent }
Procedure Paradise_Detect;
begin
With Regs do
begin
Al:= 9; { register 9 is a Paradise register }
Port[$3CE]:= Al; { 3CE is the graphics controller port }
Al:= Port[$3CF]; { try to read register 9 }
P_VGA:=(Al=0); { if it's zero, looks like Paradise }
If P_VGA then
begin
Paradise_Unlock;
P_VGA:=BankDifferent(0,1,$B800); { if Bank0<>Bank1 this IS Paradise }
end;
If P_VGA then
begin
Ah:=$00; Al:=ModeSpec[G_640x400x256].Mode; Intr(Video,Regs);
If BankDifferent(0,64,$A000) then ParadiseRam:=512
else ParadiseRam:=256;
Ah:=$00; Al:=TextModeNumber; Intr(Video,Regs);
end;
end;
end; { Procedure Paradise_Detect }
Function Paradise_Address(Row, Col: Word): Word;
Var VideoAddress, VideoPage,
MemoryAddress: LongInt;
VP: Word;
begin
{ 640x400x256 and 640x480x256 video RAM is addressed in 4k banks. }
{ As each row is 640 bytes long, the address of the video RAM is }
{ calculated as (row*640)+col, so row 479 is at 0004AD80 }
{ To write row 479, we need to select bank: 4A }
{ and move the graphics data to: A000:0D80 }
With Regs do
begin
VideoAddress:= LongInt(Row)*640+Col;
VideoPage:= (VideoAddress and $000FF000);
VideoPage:= (VideoPage shr 12);
MemoryAddress:=(VideoAddress and $00000FFF);
VP:=VideoPage;
Al:=$09; Ah:=VP; PortW[$3CE]:=Ax;
Paradise_Address:=MemoryAddress;
end;
end; { Function Paradise_Address }
Procedure ClearTextScreenAndSetBorder(X, Y, A, B: Byte);
begin
With Regs do
begin
Ax:=$0600; Bh:=A; Cx:=0; Dh:=Pred(Y); Dl:=Pred(X); Intr(Video,Regs);
Case VideoType of
MDA: begin end; { no MDA border }
EGA: begin end; { no EGA border.. it works, but is ugly! }
CGA: begin
Ax:=$0B00; Bh:=0; Bl:=B; Intr(Video,Regs);
end;
else begin
Ax:=$1001; Bh:=B; Intr(Video,Regs);
end;
end; { Case VideoType }
end;
end; { Procedure ClearTextScreenAndSetBorder }
Procedure SetMCGAPalette;
begin
With Regs do
begin
Ax:=$1012; Bx:=32; Cx:=224;
Es:=Seg(Palette256); Dx:=Ofs(Palette256[32]);
Intr(Video,Regs);
end;
end; { Procedure SetMCGAPalette }
Procedure SetEgaWriteMode(Mode: Byte);
begin
With Regs do
begin
Al:=$05; Port[$3CE]:=Al;
Al:=Mode; Port[$3CF]:=Al;
end;
end; { Procedure SetEgaWriteMode }
{$EndIf }
{ ________________________ TEXT ROUTINES ____________________________________}
Procedure WriteHorizontalRuler(L, Y: Byte);
Var X: Byte;
S: String[3];
begin
TextColor(White); GotoXY(1,Succ(Y)); Write(LeftArrowHead);
For X:=2 to Pred(L) do Write(HorizontalLine);
Write(RightArrowHead);
For X:=1 to L do
begin
Str(X:3,S);
If (Pred(X) mod 5)=4 then
begin
If L>99 then begin GotoXY(X,Y-2); Write(S[1]); end;
GotoXY(X,Y-1); Write(S[2]);
GotoXY(X,Y); Write(S[3]);
end
else
begin
If L>99 then begin GotoXY(X,Y-2); Write(' '); end;
GotoXY(X,Y-1); Write(' ');
GotoXY(X,Y); Write('.');
end;
end;
end; { Procedure WriteHorizontalRuler }
Procedure WriteVerticalRuler(L, X: Byte);
Var Y: Byte;
begin
TextColor(Yellow); GotoXY(X+4,1); Write(UpArrowHead);
For Y:=2 to Pred(L) do begin GotoXY(X+4,Y); Write(VerticalLine); end;
GotoXY(X+4,L); Write(DownArrowHead);
For Y:=1 to L do begin GotoXY(X,Y); Write(Y:3); end;
end; { Procedure WriteVerticalRuler }
Procedure DemonstrateTextMode(WhichMode: ModeType);
Var HLine, VLine, BC, TC: Byte;
begin
With ModeSpec[WhichMode] do
begin
SetVideoMode(Mode,MaxY); WindMax:=(Pred(MaxY) shl 8)+Pred(MaxX);
ClearTextScreenAndSetBorder(MaxX,MaxY,$1F,$04);
{ $1F attribute is White on Blue, $04 border is red }
GotoXY(1,1); TextBackground(Blue);
TextColor(LightCyan);
Write('Text mode: ',MaxX,' x ',MaxY,' x ',MaxC,' colors');
HLine:=MaxY shr 1; VLine:=MaxX shr 1;
For BC:=0 to 7 do
begin
GotoXY(2,MaxY-8+BC); TextBackground(BC);
For TC:=0 to 15 do begin TextColor(TC); Write(' *'); end;
Write(' ');
end;
TextBackground(Blue);
WriteVerticalRuler(MaxY,VLine); WriteHorizontalRuler(MaxX,HLine);
TextColor(LightRed);
GotoXY(MaxX-13,MaxY);
Write('Press a key >'); Wait;
end;
end; { Procedure DemonstrateTextMode }
{ ________________________ GRAPHICS ROUTINES ________________________________}
Procedure Calculate(Lines, Sections: Word; Var SectionSize, Offset: Word);
{ Based on the number of graphics lines on the screen, and the number of }
{ sections we want, calculate the number of lines per section and the }
{ "remainder", which we'll leave at the top of the screen. }
begin
SectionSize:=Lines div Sections; Offset:=Lines-(Sections*SectionSize);
end; { Procedure Calculate }
Procedure BuildMcgaPalette;
{ The default 256 color palette has the "standard" 16 colors, followed by a }
{ 16 level gray scale. This is followed by three sets of 72 colors (in high, }
{ medium, and low intensity) which is not particularly interesting to see. }
{ We'll build a color palette for colors 32..255 that's more appealing. }
Var Color, Block, Col: Byte;
begin
For Block:=2 to 15 do
For Col:=0 to 15 do
begin
Color:=Block*16+Col;
Palette256[Color,0]:=4*(17-Block)+3; { Red: Decreasing vert. }
Palette256[Color,1]:=4*Col; { Green: Increasing horiz. }
Palette256[Color,2]:=4*(15-Col)+3; { Blue: Decreasing horiz. }
end;
end; { Procedure BuildMcgaPalette }
Procedure WriteCGA(M, X, Y, C: Word);
Var Block, Line, Color, Row, Row2: Byte;
Const Pat: Array[0..3,0..1] of Byte = (($11,$22),($96,$69),
($AA,$55),($FF,$FF));
begin
SetVideoMode(M,Y);
If C=2 then { if 2 colors, display four patterns }
For Block:= 0 to 3 do
For Line:=0 to 49 do
begin
Row:=Block*50+Line; Row2:=Row shr 1;
If Odd(Row) then FillChar(CGA1[Row2,0],80,Pat[Block,1])
else FillChar(CGA0[Row2,0],80,Pat[Block,0]);
end
else
For Block:= 0 to 3 do
begin
Color:=Block*$55;
For Line:=0 to 49 do
begin
Row:=Block*50+Line; Row2:=Row shr 1;
If Odd(Row) then FillChar(CGA1[Row2,0],80,Color)
else FillChar(CGA0[Row2,0],80,Color);
end;
end;
end; { Procedure WriteCGA }
Procedure WriteEGA(M, X, Y, C: Word);
Var Block, Line, Row, Col: Word;
RowOfs, ColOfs, ByteOfs: Word;
Lines, Offset: Word;
AByte: Byte;
begin
SetVideoMode(M,Y);
Calculate(Y,16,Lines,Offset);
If C=2 then { 2 colors, display 16 patterns }
For Block:=0 to 15 do
For Line:=0 to Pred(Lines) do
begin
Row:=Block*Lines+Line+Offset;
RowOfs:=Row*(X div 8);
FillChar(EGA0[RowOfs],(X div 8),Block*$11);
end
else
For Block:=0 to 15 do
For Line:=0 to Pred(Lines) do
begin
Row:=Block*Lines+Line+Offset;
RowOfs:=Row*(X div 8); { address of row,0 }
SetEgaWriteMode(2);
FillChar(EGA0[RowOfs],(X div 8),Block);
SetEgaWriteMode(0);
end;
end; { Procedure WriteEGA }
Procedure WriteMCGA(M, X, Y, C: Word);
Var Block, Line, Row, Col, Color: Word;
Lines, Offset: Word;
begin
SetVideoMode(M,Y);
SetMCGAPalette; Calculate(200,16,Lines,Offset);
For Block:=0 to 15 do
For Line:=0 to Pred(Lines) do
begin
Row:=Block*Lines+Line+Offset;
For Col:=0 to 15 do
begin
Color:=Block*16+Col;
FillChar(MCGA0[Row,Col*20],20,Color);
end;
end;
end; { Procedure WriteMCGA }
Procedure WritePVGA(M, X, Y, C: Word);
Var Block, Line, Row, Col, Color: Word;
MA: Word;
begin
SetVideoMode(M,Y);
SetMCGAPalette;
Paradise_Unlock; { unlock write access to extended registers }
For Block:=0 to 15 do
begin
For Col:=0 to 15 do
begin
Color:=Block*16+Col; FillChar(Pixels[Col*40],40,Color);
end;
For Line:=0 to 23 do
begin
Col:=0;
Row:=Block*24+Line+16;
MA:=Paradise_Address(Row, Col); { bank select, calc destination }
Move(Pixels,Mem[$A000:MA],X);
end;
end;
MA:=Paradise_Address(0, 0); { select bank 0 (before text write) }
end; { Procedure WritePVGA }
Procedure DemonstrateGraphicsMode(WhichMode: ModeType);
begin
DirectVideo:=False; { CRT unit should not move text to video RAM, }
{ but use BIOS calls to write text in graphics modes. }
With ModeSpec[WhichMode] do
begin
Case Method of
CGA: WriteCGA( Mode, MaxX, MaxY, MaxC);
EGA: WriteEGA( Mode, MaxX, MaxY, MaxC);
MCGA: WriteMCGA(Mode, MaxX, MaxY, MaxC);
PVGA: WritePVGA(Mode, MaxX, MaxY, MaxC);
end; { Case Method }
GotoXY(1,1);
Write(InterpretModeDescription(Desc));
Write(' Graphics: ',MaxX,'x',MaxY,'x',MaxC,' colors.');
Wait;
end;
end; { Procedure DemonstrateGraphicsMode }
{ ________________________ GENERAL ROUTINES _________________________________}
Procedure WriteMainScreen;
begin
SetVideoMode(TextModeNumber,25); DirectVideo:=True;
ClearTextScreenAndSetBorder(80,25,$07,$00);
{ attribute $07 = LightGray on Black, border $00 = black }
GotoXY(1,1);
TextBackground(Black); TextColor(LightCyan); Write('Video system: ');
TextColor(LightGreen);
Case VideoType of
MDA: WriteLn('Monochrome Display Adapter (MDA)');
CGA: WriteLn('Color Graphics Adapter (CGA)');
EGA: WriteLn('Enhanced Graphics Adapter (EGA)');
MCGA: WriteLn('Multi-Color Graphics Array (MCGA)');
VGA: WriteLn('Video Graphics Array (VGA)');
PVGA: WriteLn(ParadiseRam,'k Paradise VGA adapter');
end; { Case VideoType }
TextColor(Yellow);
WriteLn('┌','──────────────────────────────────','┐');
For VMode:=T_80x25x2 to G_640x480x256 do With ModeSpec[VMode] do
begin
Write('│ ');
If ModeAvailable[VideoType,VMode] then TextColor(White)
else TextColor(LightGray);
Write(InterpretModeDescription(Desc));
If VMode in [T_80x25x2..T_132x43x16] then Write(' text: ')
else Write(' graphics: ');
Write(MaxX:4,' x ',MaxY:3,' x ',MaxC:3);
TextColor(Yellow);
WriteLn(' │');
end;
WriteLn('└','──────────────────────────────────','┘');
TextColor(LightRed);
WriteLn('Move to desired mode using cursor arrow keys.');
WriteLn('Press right arrow or carriage return to execute.');
WriteLn('Press ESCape to exit.');
TextBackground(LightGray); TextColor(Black);
For N:=1 to InfoLines do
begin GotoXY(45,N+2); Write(InfoLine[N]); end;
TextBackground(Black); TextColor(White); NeedNewScreen:=False;
end; { Procedure WriteMainScreen }
Procedure DemonstrateMode(Which: Byte);
Var M: ModeType absolute Which;
begin
If ModeAvailable[VideoType,M] then
begin
TextColor(White);
If M>T_132x43x16 then DemonstrateGraphicsMode(M)
else DemonstrateTextMode(M);
NeedNewScreen:=True;
end;
end; { Procedure DemonstrateMode }
Procedure ProcessKeyStroke;
begin
If NeedNewScreen then WriteMainScreen;
GotoXY(2,SelectionLine+3); Write(RightArrowHead);
GotoXY(2,SelectionLine+3);
Ch:=ReadKey;
If Ch=Null then { extended key (eg. cursor key) }
begin
Ch:=ReadKey;
Case Ch of { translate cursor keys }
#71: Ch:='7';
#72: Ch:='8';
#73: Ch:='9';
#77: Ch:='6';
#79: Ch:='1';
#80: Ch:='2';
#81: Ch:='3';
end; { Case Ch }
end;
Write(' ');
Case Ch of
'7', { Home }
'9': SelectionLine:=0; { PgUp }
'8': If SelectionLine>0 then Dec(SelectionLine) { Up }
else SelectionLine:=Options;
'2': If SelectionLine<Options then Inc(SelectionLine) { Dn }
else SelectionLine:=0;
'1', { End }
'3': SelectionLine:=Options; { PgDn }
'6', { Rgt }
^M: DemonstrateMode(SelectionLine); { carriage return }
end; { Case Ch }
end; { Procedure ProcessKeyStroke }
{
[][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
[] Paradise_VGA MainLine []
[][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
}
begin
P_VGA:=False; ParadiseRam:= 0; IdentifyVideo;
If VideoType=MDA then TextModeNumber:=7 else TextModeNumber:=3;
Case VideoType of
UnSupported: begin WriteLn('Un-supported video type.'); Halt(1); end;
VGA: begin
Paradise_Detect;
If P_VGA then
begin
VideoType:=PVGA;
ModeAvailable[PVGA,G_640x480x256]:= (ParadiseRam>256);
end;
end;
end; { Case VideoType }
BuildMCGAPalette; SelectionLine:=0; NeedNewScreen:=True;
Repeat ProcessKeyStroke; Until Ch=ESCape;
TextColor(LightGray); SetVideoMode(TextModeNumber,25);
GotoXY(1,1);
For N:=1 to GoodbyLines do WriteLn(GoodbyLine[N]);
end.